00010	C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), HOMER,
00110	C  (PLACE), (FINDIT), SCL
06300	
06500		SUBROUTINE SLUR
06600		IMPLICIT INTEGER(A-Q,T-Z)
06610		COMMON/SLR/ SLURX(72)
06700		REAL CENTR,PWDS
06710		COMMON /XRN/RN(4000) /PLTR/PLT,RHT,RDIS
06900		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
06950		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
06962		1 J5,J6,J7,J8,J9,J10,J11,JQ(9)
07000		COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSJT2
07010		COMMON/ALF/INP,SLURY(72) 
07400	CF	DATA RZZ/2.8/
07500	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	
07600	
07805		IF(JA.NE.12)GO TO 2
07810	CF	RA=5.96*RSJT2*R5
07815	CF	L=3
07817	CF	J8=J8*RDIS
07820	CF	IF(J7.LE.J6)J7=J7+360
07822	CF	KQ=6
07823	CF	IF(PLT)KQ=1
07825	CF10	DO 3 K=J6,J7,KQ
07830	CF	R=K
07835	CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
07840	CF3	L=2
07841	CF	J8=J8-1
07842	CF	IF(J8)RETURN
07843	CF	RA=RA+1/RDIS
07845	CF	L=3
07847	CF	GO TO 10
07848	CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
07849		CALL CIRCLE
07850		RETURN
07880	
07900	2	J10=1
07901		J4=-1
07902		KQ=3
07903		TWICE=-1
07904	C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
07905		IF(PLT.GE.0)GO TO 21
07907		IF(J8.GT.0)GO TO 21
07910		TWICE=0
07912		KQ=1
07915		RWID=.2
07920		IF(RHT.LT.2)GO TO 21
07925		TWICE=1
07927		RWID=.14
07928	C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
07930	21	RST7=RSJT2*7.
07960		RQQ=R5-R4
08000		IF(R6.GT.1000)CALL RNOTE(R6)
08010		GO TO (5,6,7),J8+4
08015		GO TO 4
08020	5	R=32
08025	C AFTER DOTTED NOTE
08030		GO TO 8
08040	6	R=22
08045	C BETWEEN NOTES
08050	8	RX=-1.3
08060		GO TO 9
08070	7	R=7
08080		RX=RSJT2
08090	9	CALL RJBX(R)
08100		R6=R6+RX
08250	4	RXX=RHORZ(R6)-R3
08260		RTILT=RQQ*RST7
08270	80	RX=SQRT(RXX**2+RTILT**2)
08280	1	R=CENTR
08300		IF(J8.GT.0)GO TO 180
08310		L=72
08400	C  FOR BRACKETS
08405		CALL SLOOP
08407	
08410	CF	RB=RX/71.
08500	CF	DO 81 K=0,71
08600	CF81	SLURX(K+1)=RB*(K)+R3
08700	CF	RA=R7*RST7
08775	CF41	IF(R9.EQ.0)R9=RZZ
08800	CF	R=R+RA
08900	CF	L=0
09000	CF	DO 40 K=36,1,-1
09100	CF	L=L+1
09200	CF	RW=R-RA*(K/36.)**R9
09300	CF	SLURY(L)=RW
09400	CF40	SLURY(73-L)=RW
09600	CF	L=72
09700	
09800	CF89	IF(RTILT.EQ.0)GO TO 87
10000	CF	RW=ATAN2(RTILT,RXX)
10100	CF	RA=SIN(RW)
10200	CF	RB=COS(RW)
10300	CF	RZ=SLURX(1)
10400	CF	RW=SLURY(1)
10800	CF	DO 83 K=1,L
10900	CF	R=SLURX(K)-RZ
10950	CF	RXX=SLURY(K)-RW
11000	CF	SLURX(K)=RB*R-RA*RXX+RZ
11100	CF83	SLURY(K)=RB*RXX+RA*R+RW
11200	
11300	87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
11310		J5=KQ
11320		J6=J10
11330		J7=L
11340		IF(J4.NE.0)GO TO 22
11350		CALL EXCH(J6,J7)
11360		J5=-1
11400	22	DO 88 K=J6,J7,J5
11500	88	CALL LINES(SLURX(K),SLURY(K),2)
11505		IF(J5.GT.1)CALL LINES(SLURX(72),SLURY(72),2)
11507	C  DISPLAY END POINT OF SLUR
11510		IF(TWICE)RETURN
11520		TWICE=TWICE-1
11522		IF(J8.GT.0)GO TO 182
11525		J4=J4+1
11530		R7=R7+RWID
11535	C  RWID=WIDTH OF SLUR -- SEE DATA
11540		GO TO 1
11700	180	RW=R+R7*RST7
11710		TWICE=-1
11750		KQ=1
11800		RX=RX+R3
11900	CC	RA=(R5-R4)*RST7
11910		IF(J9.EQ.0)GO TO 181
11911		RZ=RTILT/(RX-R3)
11912		TWICE=2
11913	CC	RZ=RX-R3
11914		RXX=RX
11916		RWID=(R3+RXX)/2.
11992	182	IF(TWICE.EQ.1)GO TO 183
11993	C  DOES LEFT SIDE FIRST.
11994		IF(TWICE.EQ.0)GO TO 184
11995	C LAST IS NUMBER.
11996		J8=2
11999		RC=RSJT2*13.
12000		RX=RWID-RC
12010		RWW=RTILT
12012	185	RTILT=RZ*(RX-R3)
12020	
12030	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
12040	
12050		GO TO 181
12060	183	J8=3
12062		RX=RXX
12066		RTILT=RWW
12068		RXX=R3
12070		R3=RWID+RC
12082		RXX=RZ*(R3-RXX)
12100		R=R+RXX
12110		RW=RW+RXX
12120		GO TO 185
12150	
12180	181	SLURX(1)=R3
12190		SLURY(1)=R
12200		SLURX(2)=R3
12300		SLURY(2)=RW
12400		SLURX(3)=RX
12500		SLURY(3)=RW+RTILT
12600		SLURX(4)=RX
12700		SLURY(4)=R+RTILT
12800		L=4
12900		IF(J8.EQ.2)L=3
13000		IF(J8.EQ.3)J10=2
13010	CC	TWICE=-1
13100		GO TO 87
13110	184	J3=RWID
13120	C  PUT IN VERT. POS. WHEN SLOPE!
13130		R4=RQQ/2.+R4+R7-1.
13135		R6=1.
13137		R7=0
13140		CALL MAKNUM(R9)
13200		END
13300	C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
13400	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
13500	C  P9=NUM IN BRACKET(IF NON-ZERO)
13600	
13700	C********  JUGGLER  ********
13800	CF	SUBROUTINE JUGGLE
13900	CF	IMPLICIT INTEGER(A-Z)
14000	CF	REAL PWDS,RN
14100	CF	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
14200	CF    COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
14300	
14400	CF	ITEM=ITEM-1
14500	CF	JX=RN(MEDIT)+3
14600	C  WD CNT OF OLD ITEM
14700	C  I-IX IS WD CNT OF NEW ITEM
14800	CF	JY=IX
14900	CF	Z=I-IX-JX
15000	C  SPACE CHANGE
15100	CF	IF(Z)2751,172,751
15200	CF751	CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
15300	CF	JY=IX+Z
15400	CF	GO TO 172
15500	
15600	CF2751	CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
15700	
15800	CF172	J=RN(JY)+2
15900	CF	CALL LOOP(0,J,1,MEDIT,JY,RN)
16000	CF	I=IX+Z
16100	
16200	CF1751	X=ITEM+1
16300	CF	JX=WDS(X22+1)-WDS(X22)
16400	CF	J=WDS(X+1)-WDS(X)
16500	CF	Y=J-JX
16600	CF	JX=WDS(X)+Y+1
16700	CF	IF(Y)2851,182,282
16800	CF282	CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
16900	CF	GO TO 182
17000	
17101	CF2851	CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
17200	CF	JX=WDS(X)+1
17300	
17401	CF182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
17500	CF	DO 183 K=X22+1,X
17600	CF	PWDS(K)=PWDS(K)+Z
17700	CF183	WDS(K)=WDS(K)+Y
17800	CF	ST(2)=WDS(X)
17900	CF	X22=0
18000	CF	END
18100	
18200	
18300	CF	SUBROUTINE LOOP(I,J,K,L,M,N)
18400	CF	DIMENSION N(1)
18420	CF	MM=M-L
18500	CF	DO 1 NN=I+L,J+L,K
18600	CF1	N(NN)=N(NN+MM)
18700	CF	END
19300	
19400	
19500		SUBROUTINE PLTSRT
19600	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
19700	CF	IMPLICIT INTEGER(S-Z)
19800		COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
19940		COMMON/DPY/Q(3000),P(1000),WDS(250),MEDIT,IGO
19970	C  Q AND P OCCUPY DPY BUFFER.  Q IS FOR OVERFLOW OF RN.
19985		CALL PSRT(P)
20000	CF	DO 4 K=1,ITEM
20100	CF	L=PWDS(K)
20150	CF	A=RN(L+3)
20200	CF	P(K)=A+1000*RN(L+2)
20250	CF4	IF(A.LT.0)GO TO 77
20262	CF	IF(RN(L+1).NE.16.)GO TO 177
20268	CF77CF	P(K)=-10000
20275	C  PLOTS ALL NEG. HORIZ. POSITIONS AND WORDS(CODE 16) FIRST.
20300	CF177CF	M=I
20320	CF	IF(I.LT.1500)I=1500
20340	CF	Y=I
20360	CF	I=I+M-1
20380	CF	M=Y
20400	C  M IS IN MAIN PROG., LEAVES 1500 WDS IN RN FOR "NOIR" DATA.
20500	CF2CF	A=P(1)
20600	CF	L=1
20700	CF	DO 1 K=1,ITEM
20800	CF	IF(A.LE.P(K))GO TO 1
20900	CF	A=P(K)
21000	CF	L=K
21100	CF1CF	CONTINUE
21200	CF	IF(A.EQ.10000.)RETURN
21300	C  ALL ITEMS HAVE NOW BEEN SHUFFLED
21400	CF	V=PWDS(L)
21500	CF	P(L)=10000
21600	CF	L=RN(V)+2
21700	CF	CALL LOOP(0,L,1,Y,V,RN)
21800	CF	Y=Y+L+1
21900	CF	GO TO 2
22000		END
22100	
22200	
22300	
22400		SUBROUTINE BOX(I,R,STFF)
22500	      COMMON/SIZ/RSZ,JCEN,KCEN /XRN/RN(4000) /STF/RSTFAC(-3/4),RSJT2
22925		DIMENSION STFF(1),N(100)
22962		EQUIVALENCE (N,RN(2901))
23000		IF(I)GO TO 4
23100		K=R
23200		K=(STFF(K+4)+AMOD(RN(I+4),100.0)*7.*RSTFAC(K)
23300		1 -40.0)*RSZ-KCEN
23350	C  ↑↑↑↑ WAS -60.0 10/74
23400	C  AMOD IS FOR MINI NOTES AND CLEFS
23500		L=RHORZ(RN(I+3))*RSZ-JCEN
23600		IF(IABS(L).GT.550)L=511
23700		IF(IABS(K).GT.550)K=511
23800	CC1	CALL ALINE(L,K,L+50,K)
23900	CC	CALL RVECT(0,100)
24000	CC	CALL RVECT(-50,0)
24100	CC	CALL RVECT(0,-100)
24200	CC	L=L+25
24300	CC2	CALL ALINE(L,K-25,L,K+125)
24450	CC3	CALL DPYOUT(1)
24460		CALL SETCUR(L,K,0)
24500		RETURN
24600	4	IF(I.LT.-1)GO TO 5
24700		CALL DPYSET(3,N,100)
24800		CALL DPYBRT(3)
24900	5	L=RHORZ(R)*RSZ-JCEN
25000		IF(IABS(L).GT.550)GO TO 6
25050	C DOESN'T TRY TO DRAW LINE OFF SCREEN
25100		CALL SETPOG(3)
25200		CALL ALINE(L,-511,L,511)
25300		CALL DPYOUT(3)
25400	6	CALL SETPOG(1)
25600		END
25700	
25800	CC	SUBROUTINE LINES(A,B,L)
25850	CC	COMMON/DST/BB,CC
25900	CC	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
26000	CC	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
26100	CC	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
26200	CC	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
26400	CC	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
26402	CC	1,(JJ2,JJ(2))
26500	CC	DATA BB/.008/,CC/3.5/
26600	C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
26650	CC	GO TO 23
26700	CC
26725	CC22	IF(JQ(1).NE.0)GO TO 23
26750	CC	IF(CC.EQ.1000)GO TO 23
26775	C  ABOVE TO SKIP DISTORTION ON COMMAND
26800	C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.
27000	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
27100	CC	B=B*(CC-BB*ABS(A))
27150	C  CC IS HGT FACTOR.
27200	CC23	IF(IPLT)GO TO 2
27300	CC	M=A*RSZ
27400	CC	N=B*RSZ
27500	CC	IF(RSZ.LE.0.8571)GO TO 3
27600	C NEXT FOR DISPLAY MAGNIFICATION
27700	CC	M=M-JCEN
27800	CC	N=N-KCEN
27900	CC	IF(JA.NE.8)GO TO 5
28000	C NEXT INSURES DISPLAY OF STAFF LINES
28100	CC	IF(M.GT.511)M=511
28200	CC	IF(M.LT.-511)M=-511
28400	CC5	IF(IABS(M).GT.512)GO TO 77
28450	CC	IF(IABS(N).LT.512)GO TO 4
28500	C  NOW DRAWS INVISIBLE VECT. IF IT GOES OFF THE SCREEN.
28600	CC77	KZ=-1
28700	CC	RETURN
28800	CC4	IF(KZ.EQ.0)GO TO 6
28900	CC	KZ=0
29000	CC	GO TO 1
29050	CC3	IF(JA.EQ.44)GO TO 6
29075	C JA=44=BAR LINES - THEY DON'T FIGURE IN MAX. HGT.
29100	CC	K=B
29200	CC	IF(K.GT.ITOP)ITOP=B
29300	CC	IF(K.LT.IBOT)IBOT=B
29302	CC6	IF(JJ2.GT.3990)RETURN
29400	CC	IF(L.EQ.3)GO TO 1
29500	CC	CALL AVECT(M,N)
29600	CC	RETURN
29700	CC1	CALL AIVECT(M,N)
29800	CC	RETURN
29900	CC2	IF(IPLT.EQ.-2)RETURN
30300	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
31110	CC9	M=ROFF(A*DIS)
31120	CC	N=ROFF(B*RHT)
31200	CC8	CALL PLOT(M,N,L)
31400	CC	END
31540	
35100	C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
35200		SUBROUTINE HOMER
35300		IMPLICIT INTEGER(A-Q,S-Z)
35400		REAL PWDS,DISX,A,B,PLACE,STFF
35500		COMMON /STF/RSTFAC(-3/4),RSTJ2
35600	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
35700		COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
35800		COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
35900		EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
36000		1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
36100		1,(J10,JQ(8)),(R8,RJQ(6))
36200		IF(JA.EQ.6)GO TO 9
36300		IF(R13.NE.0)GO TO 10
36400	C  FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
36500	
36600		IF(JQ(1).EQ.0)GO TO 197
36700	C  TO HOME IN ON NOTE ON DIFFERENT STAFF.
36800		JJ2=R2
36900		K=PWDS(JJ2)
37000		L=PWDS(JQ(1))
37100		RA=RN(K+3)
37200		RB=RN(L+3)
37300	C  RB=POS OF NOTE,  RA=POS(P3) OF BEAM
37400		N=0
37500		IF(RN(L+5).LT.20)N=-1
37600	C  -1 MEANS STEM IS UP
37700		RG=-(AMOD(RN(K+7),10.)-1.)*11./7.
37800	C   SPACE FOR THE NUMB. OF BEAMS
37900		J11=RN(L+2)
38000		M=0
38100		IF(RN(K+7).LT.20.)M=-1
38200		X=RN(K+2)
38300	C  THE STAFF NUMS.  X=BEAM   J11=NOTE
38400		R3=RSTFAC(X)
38500		R9=RSTFAC(J11)/R3
38600		R8=R3*14.54/5.96
38700	C  R8=WIDTH OF NOTE
38800	C******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
38900		R7=96./7.
39000	C  MUST BE DOUBLE STEM LENGTH
39100		RD=RN(L+8)
39200	CC	IF(RD.EQ.999)RD=0
39300	C  THE STEM LENGTH
39400	CC2	JD=6
39500	CC	J10=5
39600	CC	IF(RA+3.GE.RB)GO TO 3
39700	CC	JD=6
39800	CC	J10=5
39900	3	IF(M.NE.N)GO TO 5
40000		R8=0
40100		R7=0
40200		RG=0
40300		GO TO 4
40400	5	IF(M.EQ.0)GO TO 4
40500		R7=-R7
40600		R8=-R8
40700		RD=-RD
40800		RG=-RG
40900	
41000	C  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
41100	4	RN(K+6)=RB+R8
41200	C  SETS CORRECT HORIZANTAL PARAM OF BEAM.
41300		RF=7.*R9
41400		RE=(STFF(J11)-STFF(X))/RF
41500	C  DIST BETWEEN STAVES.
41600		RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
41700		RETURN
41800	
41900	C*********************************************************
42000	C  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
42100	197	JJ2=-1
42200	
42300		R3=R2
42400		DO 191 K=1,ITEM
42500		L=PWDS(K)
42600		IF(RN(L+1).NE.6)GO TO 191
42650		IF(RN(L+2).EQ.R3)GO TO 77
42675		IF(R3.LT.5.)GO TO 191
42700	C   TYPE 19 99 FOR ALL STAVES
42800	77	RG=RN(L+7)
42900		IF(RN(L).EQ.8)GO TO 191
42950		IF(RG.LT.10.)GO TO 191
43000	C  FINDS BEAMS.
43100		A=RN(L+3)-.01
43200		B=RN(L+6)+.01
43300	C  POS 1 AND 2
43400		DISX=B-A
43500	C  DISTANCE IN REAL STEPS
43600		RB=AMOD(RN(L+5),100.0)
43700	C  NOTE 2
43800		RF=AMOD(RN(L+4),100.0)
43900		RD=RB-RF
44000	C  HEIGHT
44100		R2=RN(L+2)
44200	C  ↑↑↑ USED IN 'FINDIT'
44300		X=RG/10.
44400	C  STEM DIRECT.
44500	
44600		DO 192	N=1,ITEM
44700	CC	L=PWDS(N)
44800		IF(FINDIT(N))GO TO 192
44900		IF(RN(L).EQ.8)GO TO 192
44950		IF(RN(L+8).EQ.1000.)GO TO 192
45000	C SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
45100	C  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
45200		RC=RN(L+3)
45300		IF(RC.LT.A)GO TO 192
45350		IF(RC.GT.B)GO TO 192
45400	C  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
45500		IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
45600		RC=RC-A
45700	193	RE=AMOD(RN(L+4),100.0)
45800		RC=RD*RC/DISX+RF
45900		RG=RN(L+7)
46000		RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
46100	C   DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
46200	C  FRACTIONAL NOTE #
46300	195	RA=RC-RE
46400		IF(X.EQ.2)RA=-RA
46500		IF(RA.EQ.0)RA=999.
46600	196	RN(L+8)=RA
46700	C  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
46800		IF(JJ2)JJ2=N
46900	C  SAVES # OF FIRST ITEM FOUND
47000	192	CONTINUE
47100	191	CONTINUE
47200		RETURN
47300	
47400	C*********************************************************
47500	9	IF(J11.LT.0)RETURN
47600	C   IF P11=-1 NO HOMING
47700		X=R7/10.
47800	C  X IS STEM DIRECTION
47900		RA=R9
48000	C  R9= POS3
48100		RC=-1.
48200		IF(R9.NE.0)RC=-2.
48300		IF(J10/100.EQ.3)RC=-3
48400	C  RC=1 ESCAPES FROM LOOP.
48500	C   HOMING RANGE FOR BEAMS
48600	10	IF(R11.EQ.0)R11=2.9
48700	C   IF P11.NE.0 RANGE IS CHANGED FROM 2
48800		IF(JA.EQ.8)RC=-1
48900		DO 361 K=1,ITEM
49000		IF(FINDIT(K))GO TO 361
49100	C  SKIPS NOTES ON WRONG LINE 
49200		RD=RN(L+3)
49300	1	IF(JA.NE.6)GO TO 177
49350		IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
49400	177	IF(PLACE(R3))GO TO 461
49500		R3=RD
49600	C  LOOKS FOR NOTE, STAFF #, STEM DIR.
49700		IF(JA.EQ.6)GO TO 261
49750		IF(JA.EQ.5)GO TO 261
49800		RETURN
49900	
50000	461	IF(JA.EQ.6)GO TO 277
50050		IF(JA.NE.5)GO TO 361
50100	277	IF(PLACE(R6))GO TO 561
50200		R6=RD
50300		GO TO 261
50400	561	IF(PLACE(RA))GO TO 661
50500		R9=RD
50600		GO TO 261
50700	661	IF(JA.EQ.5)GO TO 361
50750		IF(J10.LT.300)GO TO 361
50800		IF(PLACE(R8))GO TO 361
50900	C  HOMES INNER PARTIAL BEAMS
51000		R8=RD
51100	261	RC=RC+1
51200		IF(RC.EQ.1.)RETURN
51300	361 	CONTINUE
51400		END
51500	
51600	CF	FUNCTION PLACE(X)
51700	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
51800	CF	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
51900	CF	PLACE=R11-ABS(RD-X)
52000	CF	END
52100	
52200	CF	FUNCTION FINDIT(N)
52300	CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
52400	CF	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
52500	CF	FINDIT=0
52600	CF	L=PWDS(N)
52700	CF	IF(RN(L+1).NE.1)GO TO 377
52750	CF	IF(RN(L+2).EQ.R2)RETURN
52775	CF377	FINDIT=-1
52800	CF	END
52900	
53000		SUBROUTINE SCL
53100	C  SETS UP SCALING MARKERS.
53200		DIMENSION SU(400)
53300		COMMON /STF/RSTFAC(-3/4),RSTJ2 /XRN/RN(4000)
53400		COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
53500		1 /POSI/STFF(-3/4),J102,POS
53600		EQUIVALENCE (SU(400),RN(3001))
53700		J2=R2
53800		IF(J2.NE.99)GO TO 1008
53900		CALL HYDPOG(2)
54000		RETURN
54100	1008	J5=0
54200		J6=0
54300		RSTJ2=RSTFAC(J2)
54400	C  SETS UP SCALE LINES.
54500		J4=200
54600		IF(R3.NE.0)J4=400
54700	C  PUTS SCALE TO 400
54800		R2=STFF(J2)+60.*RSTJ2
54900		RJ=R2+60.
55000		CALL DPYSET(2,SU,700)
55100		CALL DPYBRT(1)
55200		POS=RJ+40.
55300		RSTJ2=1.
55400		DO 1002 MX=10,J4,10
55500		RA=RHORZ(FLOAT(MX))
55600		R3=RA-58
55700		IF(MX.GT.10)CALL PNUM
55800	CC1005	IF(R5.NE.0)GO TO 1007
55900	C  JUMP FOR STAFF NUMBERS
56000		CALL LINX(RA,R2,RA,RJ)
56100		J5=J5+1
56200	1002	IF(J5.EQ.10)J5=0
56300		CALL LINES(-596.0,RJ,2)
56400		CALL LINES(-596.0,R2,2)
56500		R6=1.5
56600	C  NEXT SETS UP STAFF NUMBERS
56700		R3=-620.
56800		DO 1007 K=-3,4
56900		POS=STFF(K)+40.
57000		J5=IABS(K)
57100		CALL PNUM
57200	1007	CONTINUE
57300		CALL DPYOUT(2)
57400		CALL SETPOG(1)
57500		END